Dim DragIt As Integer Dim DragX As Single, DragY As Single Dim MaxFont As Integer Dim TextNo As Integer Dim CheckMouseDownInClientArea As Integer Sub CheckMouseDown (X As Single, Y As Single) Dim i As Integer Dim XL, XR, YU, YD As Single SelectObject$ = "pointer" For i = 1 To 1000 'Check Text If (i <= MaxText) And (DataText(i) = 1) Then If (X >= Text1(i).Left) And (X < Text1(i).Left + Text1(i).Width) And (Y >= Text1(i).Top) And (Y < Text1(i).Top + Text1(i).Height) Then SelectObject$ = "text" TextNo = i Call TextAttrib(Text1(i)) Call Shape_FourDotMove(Text1(i)) menuText.Enabled = True Exit Sub End If End If Next i menuText.Enabled = False For i = 1 To 1000 'Check Line If (i <= MaxLine) And (DataLine(i) = 1) Then If Line1(i).X1 < Line1(i).X2 Then XL = Line1(i).X1: XR = Line1(i).X2 Else XR = Line1(i).X1: XL = Line1(i).X2 If Line1(i).Y1 < Line1(i).Y2 Then YU = Line1(i).Y1: YD = Line1(i).Y2 Else YD = Line1(i).Y1: YU = Line1(i).Y2 If (X >= XL - 15) And (X <= XR + 30) And (Y >= YU - 15) And (Y <= YD + 30) Then SelectObject$ = "line" 'Change tools.PointerStyle & tools.PointerWidth tools.PointerStyle.Top = 1920 + Line1(i).BorderStyle * 120 tools.PointerWidth.Top = 2880 + Line1(i).BorderWidth * 120 CurrentNo = i Call Line_TwoDotMove(Line1(i)) Exit Sub End If End If 'Check Diamond If (i <= MaxDiamond) And (DataDiamond(i) = 1) Then If (X >= Diamond(i).Left) And (X < Diamond(i).Left + Diamond(i).Width) And (Y >= Diamond(i).Top) And (Y < Diamond(i).Top + Diamond(i).Height) Then SelectObject$ = "diamond" 'Change tools.PointerStyle & tools.PointerWidth tools.PointerStyle.Top = 1920 + Diamond(i).BorderStyle * 120 tools.PointerWidth.Top = 2880 + Diamond(i).BorderWidth * 120 CurrentNo = i Call Shape_FourDotMove(Diamond(i)) Exit Sub End If End If 'Check Circle If (i <= MaxCircle) And (DataCircle(i) = 1) Then If (X >= Circle1(i).Left) And (X < Circle1(i).Left + Circle1(i).Width) And (Y >= Circle1(i).Top) And (Y < Circle1(i).Top + Circle1(i).Height) Then SelectObject$ = "circle" 'Change tools.PointerStyle & tools.PointerWidth tools.PointerStyle.Top = 1920 + Circle1(i).BorderStyle * 120 tools.PointerWidth.Top = 2880 + Circle1(i).BorderWidth * 120 CurrentNo = i Call Shape_FourDotMove(Circle1(i)) Exit Sub End If End If 'Check RoundRectangle If (i <= MaxRoundrectangle) And (DataRoundrectangle(i) = 1) Then If (X >= Roundrectangle1(i).Left) And (X < Roundrectangle1(i).Left + Roundrectangle1(i).Width) And (Y >= Roundrectangle1(i).Top) And (Y < Roundrectangle1(i).Top + Roundrectangle1(i).Height) Then SelectObject$ = "roundrectangle" 'Change tools.PointerStyle & tools.PointerWidth tools.PointerStyle.Top = 1920 + Roundrectangle1(i).BorderStyle * 120 tools.PointerWidth.Top = 2880 + Roundrectangle1(i).BorderWidth * 120 CurrentNo = i Call Shape_FourDotMove(Roundrectangle1(i)) Exit Sub End If End If 'Check Rectangle If (i <= MaxRectangle) And (DataRectangle(i) = 1) Then If (X >= Rectangle1(i).Left) And (X < Rectangle1(i).Left + Rectangle1(i).Width) And (Y >= Rectangle1(i).Top) And (Y < Rectangle1(i).Top + Rectangle1(i).Height) Then SelectObject$ = "rectangle" 'Change tools.PointerStyle & tools.PointerWidth tools.PointerStyle.Top = 1920 + Rectangle1(i).BorderStyle * 120 tools.PointerWidth.Top = 2880 + Rectangle1(i).BorderWidth * 120 CurrentNo = i Call Shape_FourDotMove(Rectangle1(i)) Exit Sub End If End If Next i End Sub Sub Dot1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Call DotAllHide End Sub Sub Dot1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) Dot1.MousePointer = 2 If (Button = 1) And (SelectObject$ = "line") Then Line1(CurrentNo).X1 = Dot1.Left + X Line1(CurrentNo).Y1 = Dot1.Top + Y End If End Sub Sub Dot1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) If (Button = 1) And (SelectObject$ = "line") Then Dot1.Move (Line1(CurrentNo).X1 - Dot1.Width / 2), (Line1(CurrentNo).Y1 - Dot1.Height / 2) Dot1.Visible = True: Dot2.Visible = True End If End Sub Sub Dot2_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Call DotAllHide End Sub Sub Dot2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) Dot2.MousePointer = 2 If (Button = 1) And (SelectObject$ = "line") Then Line1(CurrentNo).X2 = Dot2.Left + X Line1(CurrentNo).Y2 = Dot2.Top + Y End If End Sub Sub Dot2_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) If (Button = 1) And (SelectObject$ = "line") Then Dot2.Move (Line1(CurrentNo).X2 - Dot2.Width / 2), (Line1(CurrentNo).Y2 - Dot2.Height / 2) Dot1.Visible = True: Dot2.Visible = True End If End Sub Sub DotLD_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Call DotAllHide Select Case SelectObject$ Case "rectangle", "roundrectangle", "circle", "text", "diamond": DragX = X: DragY = Y End Select End If End Sub Sub DotLD_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) DotLD.MousePointer = 6 If Button = 1 Then Select Case SelectObject$ Case "text": 'X_LD Y_LD X_RU Y_RU Call ShapeLDZoom(Text1(TextNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "rectangle": 'X_LD Y_LD X_RU Y_RU Call ShapeLDZoom(Rectangle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "roundrectangle": 'X_LD Y_LD X_RU Y_RU Call ShapeLDZoom(Roundrectangle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "circle": 'X_LD Y_LD X_RU Y_RU Call ShapeLDZoom(Circle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "diamond": 'X_LD Y_LD X_RU Y_RU Call ShapeLDZoom(Diamond(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select End If End Sub Sub DotLD_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Select Case SelectObject$ Case "text": Call Shape_FourDotMove(Text1(TextNo)) Case "rectangle": Call Shape_FourDotMove(Rectangle1(CurrentNo)) Case "roundrectangle": Call Shape_FourDotMove(Roundrectangle1(CurrentNo)) Case "circle": Call Shape_FourDotMove(Circle1(CurrentNo)) Case "diamond": Call Shape_FourDotMove(Diamond(CurrentNo)) End Select End Sub Sub DotLU_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseDown(Button, Shift, X, Y) End Sub Sub DotLU_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) DotLU.MousePointer = 8 If Button = 1 Then Select Case SelectObject$ Case "text": 'X_LU Y_LU X_RD Y_RD Call ShapeLUZoom(Text1(TextNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "rectangle": 'X_LU Y_LU X_RD Y_RD Call ShapeLUZoom(Rectangle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "roundrectangle": 'X_LU Y_LU X_RD Y_RD Call ShapeLUZoom(Roundrectangle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "circle": 'X_LU Y_LU X_RD Y_RD Call ShapeLUZoom(Circle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "diamond": 'X_LU Y_LU X_RD Y_RD Call ShapeLUZoom(Diamond(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select End If End Sub Sub DotLU_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseUp(Button, Shift, X, Y) End Sub Sub DotRD_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseDown(Button, Shift, X, Y) End Sub Sub DotRD_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) DotRD.MousePointer = 8 If Button = 1 Then Select Case SelectObject$ Case "text": 'X_LU Y_LU X_RD Y_RD Call ShapeRDZoom(Text1(TextNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "rectangle": 'X_LU Y_LU X_RD Y_RD Call ShapeRDZoom(Rectangle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "roundrectangle": 'X_LU Y_LU X_RD Y_RD Call ShapeRDZoom(Roundrectangle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "circle": 'X_LU Y_LU X_RD Y_RD Call ShapeRDZoom(Circle1(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Case "diamond": 'X_LU Y_LU X_RD Y_RD Call ShapeRDZoom(Diamond(CurrentNo), X, Y, DotLU.Left + DotLU.Width / 2, DotLU.Top + DotLU.Height / 2, DotRD.Left + DotRD.Width / 2, DotRD.Top + DotRD.Height / 2) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select End If End Sub Sub DotRD_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseUp(Button, Shift, X, Y) End Sub Sub DotRU_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseDown(Button, Shift, X, Y) End Sub Sub DotRU_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) DotRU.MousePointer = 6 If Button = 1 Then Select Case SelectObject$ Case "text": 'X_LD Y_LD X_RU Y_RU Call ShapeRUZoom(Text1(TextNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "rectangle": 'X_LD Y_LD X_RU Y_RU Call ShapeRUZoom(Rectangle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "roundrectangle": 'X_LD Y_LD X_RU Y_RU Call ShapeRUZoom(Roundrectangle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "circle": 'X_LD Y_LD X_RU Y_RU Call ShapeRUZoom(Circle1(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Case "diamond": 'X_LD Y_LD X_RU Y_RU Call ShapeRUZoom(Diamond(CurrentNo), X, Y, DotLD.Left + DotLD.Width / 2, DotLD.Top + DotLD.Height / 2, DotRU.Left + DotRU.Width / 2, DotRU.Top + DotRU.Height / 2) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select End If End Sub Sub DotRU_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Call DotLD_MouseUp(Button, Shift, X, Y) End Sub Sub DuplicateLine (DL As Line, SL As Line) DL.BorderColor = SL.BorderColor DL.BorderStyle = SL.BorderStyle DL.BorderWidth = SL.BorderWidth DL.X1 = SL.X1: DL.X2 = SL.X2 DL.Y1 = SL.Y1: DL.Y2 = SL.Y2 DL.Visible = SL.Visible End Sub Sub DuplicateShape (DS As Shape, SS As Shape) DS.Visible = False SS.Visible = False DS.BorderColor = SS.BorderColor DS.BorderStyle = SS.BorderStyle DS.BorderWidth = SS.BorderWidth DS.Shape = SS.Shape DS.Top = SS.Top: DS.Left = SS.Left DS.Width = SS.Width: DS.Height = SS.Height DS.Visible = True SS.Visible = True End Sub Sub DuplicateText (DT As TextBox, ST As TextBox) DT.Visible = False ST.Visible = False DT.BackColor = ST.BackColor DT.FontBold = ST.FontBold DT.FontItalic = ST.FontItalic DT.FontStrikethru = ST.FontStrikethru DT.FontUnderline = ST.FontUnderline DT.FontName = ST.FontName DT.FontSize = ST.FontSize DT.Height = ST.Height DT.Left = ST.Left DT.Top = ST.Top DT.Width = ST.Width DT.Text = ST.Text DT.Visible = True ST.Visible = True End Sub Sub Form_Click () If menuToolSound.Checked Then Beep End Sub Sub Form_DblClick () Dim i For i = 1 To 1000 'Check text to textedit If (i <= MaxText) And (DataText(i) = 1) Then If (DragX >= Text1(i).Left) And (DragX < Text1(i).Left + Text1(i).Width) And (DragY >= Text1(i).Top) And (DragY < Text1(i).Top + Text1(i).Height) Then SelectObject$ = "textedit" TextNo = i Text1(i).Enabled = True Text1(i).SetFocus menuTextBold.Checked = Text1(i).FontBold menuEdit.Enabled = False Call DotAllHide Exit Sub End If End If Next i End Sub Sub Form_Deactivate () If (SelectObject$ = "textedit") Or (SelectObject$ = "text") Then Call DotAllHide SelectObject$ = "pointer" Text1(TextNo).SelStart = 0 Text1(TextNo).Enabled = False If TextNo > 0 Then Text1(TextNo).BackColor = RGB(&HFF, &HFF, &HFF) menuEdit.Enabled = True End If menuText.Enabled = False End Sub Sub Form_DragDrop (Source As Control, X As Single, Y As Single) Text1(TextNo).Drag 2 Text1(TextNo).Move DotLU.Left + DotLU.Width / 2 + X - DragX, DotLU.Top + DotLU.Height / 2 + Y - DragY Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub Form_Load () '--------- Initialize status --------- Dim i As Integer, j As Integer Dim tempString As String Screen.MousePointer = 0 tools.Show tools.toolPointerOFF.Visible = False tools.toolPointerON.Visible = True tools.toolTextOFF.Visible = True tools.toolTextON.Visible = False tools.toolLineOFF.Visible = True tools.toolLineON.Visible = False tools.toolRectangleOFF.Visible = True tools.toolRectangleON.Visible = False tools.toolRoundRectangleOFF.Visible = True tools.toolRoundRectangleON.Visible = False tools.toolCircleOFF.Visible = True tools.toolCircleON.Visible = False tools.toolDiamondOFF.Visible = True tools.toolDiamondON.Visible = False tools.PointerStyle.Top = 2040 tools.PointerWidth.Top = 3000 file.Hide DragX = 0: DragY = 0 CheckMouseDownInClientArea = 0 toolStatus$ = "pointer" SelectObject$ = "pointer" A_filename = "untitled.erm" main.Caption = "NCU Graphics Draw (" + A_filename$ + ")" Call DotAllHide Text1(0).Visible = False Line1(0).Visible = False Line1(0).BorderStyle = 1 Line1(0).BorderWidth = 1 Rectangle1(0).Visible = False Rectangle1(0).BorderStyle = 1 Rectangle1(0).BorderWidth = 1 Roundrectangle1(0).Visible = False Roundrectangle1(0).BorderStyle = 1 Roundrectangle1(0).BorderWidth = 1 Circle1(0).Visible = False Circle1(0).BorderStyle = 1 Circle1(0).BorderWidth = 1 Diamond(0).Visible = False Diamond(0).BorderStyle = 1 Diamond(0).BorderWidth = 1 Diamond1(0).Visible = False Diamond1(1).Visible = False Diamond1(2).Visible = False Diamond1(3).Visible = False For i = 1 To 1000 DataText(i) = 0 DataLine(i) = 0 DataRectangle(i) = 0 DataRoundrectangle(i) = 0 DataCircle(i) = 0 DataDiamond(i) = 0 Next i MaxText = 0 MaxLine = 0 MaxRectangle = 0 MaxRoundrectangle = 0 MaxCircle = 0 MaxDiamond = 0 '------------------------------------- '---- menuTextFontName Initialize ---- menuTextFontName(0).Caption = Screen.Fonts(0) MaxFont = 1 For i = 1 To Screen.FontCount - 1 tempString$ = Screen.Fonts(i) If Left$(tempString$, 1) = "@" Then tempString$ = Right$(tempString$, Len(tempString$) - 1) End If For j = 0 To MaxFont - 1 If menuTextFontName(j).Caption = tempString$ Then GoTo CheckNextFontName Next j Load menuTextFontName(MaxFont) menuTextFontName(MaxFont).Caption = tempString$ MaxFont = MaxFont + 1 CheckNextFontName: Next i End Sub Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer If Button = 1 Then CheckMouseDownInClientArea = 1 Select Case toolStatus$ Case "pointer": If SelectObject$ = "textedit" Then Text1(TextNo).SelStart = 0 Text1(TextNo).Enabled = False Text1(TextNo).BackColor = RGB(&HFF, &HFF, &HFF) menuEdit.Enabled = True End If If SelectObject$ = "text" Then Text1(TextNo).BackColor = RGB(&HFF, &HFF, &HFF) Call CheckMouseDown(X, Y) Call DotAllHide DragX = X DragY = Y Case "text": For i = 1 To 1000 If DataText(i) = 0 Then Load Text1(i) TextNo = i If MaxText < i Then MaxText = i DataText(i) = 1 Call ShapeInitNew(Text1(i), X, Y) Call TextAttrib(Text1(i)) Exit For End If Next i Case "line": For i = 1 To 1000 If DataLine(i) = 0 Then Load Line1(i) CurrentNo = i If MaxLine < i Then MaxLine = i DataLine(i) = 1 Line1(i).X1 = X: Line1(i).Y1 = Y Line1(i).X2 = X: Line1(i).Y2 = Y Line1(i).Visible = True Exit For End If Next i Case "rectangle": For i = 1 To 1000 If DataRectangle(i) = 0 Then Load Rectangle1(i) CurrentNo = i If MaxRectangle < i Then MaxRectangle = i DataRectangle(i) = 1 Call ShapeInitNew(Rectangle1(i), X, Y) Exit For End If Next i Case "roundrectangle": For i = 1 To 1000 If DataRoundrectangle(i) = 0 Then Load Roundrectangle1(i) CurrentNo = i If MaxRoundrectangle < i Then MaxRoundrectangle = i DataRoundrectangle(i) = 1 Call ShapeInitNew(Roundrectangle1(i), X, Y) Exit For End If Next i Case "circle": For i = 1 To 1000 If DataCircle(i) = 0 Then Load Circle1(i) CurrentNo = i If MaxCircle < i Then MaxCircle = i DataCircle(i) = 1 Call ShapeInitNew(Circle1(i), X, Y) Exit For End If Next i Case "diamond": For i = 1 To 1000 If DataDiamond(i) = 0 Then Load Diamond(i) Load Diamond1(i * 4) Load Diamond1(i * 4 + 1) Load Diamond1(i * 4 + 2) Load Diamond1(i * 4 + 3) CurrentNo = i If MaxDiamond < i Then MaxDiamond = i DataDiamond(i) = 1 Call ShapeInitNew(Diamond(i), X, Y) Call DiamondDraw(Diamond(i), i) Exit For End If Next i End Select End If End Sub Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) If toolStatus$ = "pointer" Then main.MousePointer = 1 Else main.MousePointer = 2 If Button = 1 And CheckMouseDownInClientArea = 1 Then Select Case toolStatus$ Case "pointer": Select Case SelectObject$ Case "text": Text1(TextNo).Drag 1 Case "line": Line1(CurrentNo).X1 = Dot1.Left + Dot1.Width / 2 + X - DragX Line1(CurrentNo).Y1 = Dot1.Top + Dot1.Height / 2 + Y - DragY Line1(CurrentNo).X2 = Dot2.Left + Dot2.Width / 2 + X - DragX Line1(CurrentNo).Y2 = Dot2.Top + Dot2.Height / 2 + Y - DragY Case "rectangle": Rectangle1(CurrentNo).Move DotLU.Left + DotLU.Width / 2 + X - DragX, DotLU.Top + DotLU.Height / 2 + Y - DragY Case "roundrectangle": Roundrectangle1(CurrentNo).Move DotLU.Left + DotLU.Width / 2 + X - DragX, DotLU.Top + DotLU.Height / 2 + Y - DragY Case "circle": Circle1(CurrentNo).Move DotLU.Left + DotLU.Width / 2 + X - DragX, DotLU.Top + DotLU.Height / 2 + Y - DragY Case "diamond": Diamond(CurrentNo).Move DotLU.Left + DotLU.Width / 2 + X - DragX, DotLU.Top + DotLU.Height / 2 + Y - DragY Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select Case "text": If X - Text1(TextNo).Left > 100 Then Text1(TextNo).Width = X - Text1(TextNo).Left If Y - Text1(TextNo).Top > 100 Then Text1(TextNo).Height = Y - Text1(TextNo).Top Case "line": Line1(CurrentNo).X2 = X: Line1(CurrentNo).Y2 = Y Case "rectangle": If X - Rectangle1(CurrentNo).Left > 100 Then Rectangle1(CurrentNo).Width = X - Rectangle1(CurrentNo).Left If Y - Rectangle1(CurrentNo).Top > 100 Then Rectangle1(CurrentNo).Height = Y - Rectangle1(CurrentNo).Top Case "roundrectangle": If X - Roundrectangle1(CurrentNo).Left > 100 Then Roundrectangle1(CurrentNo).Width = X - Roundrectangle1(CurrentNo).Left If Y - Roundrectangle1(CurrentNo).Top > 100 Then Roundrectangle1(CurrentNo).Height = Y - Roundrectangle1(CurrentNo).Top Case "circle": If X - Circle1(CurrentNo).Left > 100 Then Circle1(CurrentNo).Width = X - Circle1(CurrentNo).Left If Y - Circle1(CurrentNo).Top > 100 Then Circle1(CurrentNo).Height = Y - Circle1(CurrentNo).Top Case "diamond": If X - Diamond(CurrentNo).Left > 100 Then Diamond(CurrentNo).Width = X - Diamond(CurrentNo).Left If Y - Diamond(CurrentNo).Top > 100 Then Diamond(CurrentNo).Height = Y - Diamond(CurrentNo).Top Call DiamondDraw(Diamond(CurrentNo), CurrentNo) End Select End If End Sub Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer If Button = 1 And CheckMouseDownInClientArea = 1 Then CheckMouseDownInClientArea = 0 If toolStatus$ <> "pointer" Then Call DisableTool If toolStatus$ = "text" Then SelectObject$ = "textedit" Text1(TextNo).Enabled = True Text1(TextNo).SetFocus menuEdit.Enabled = False Else SelectObject$ = toolStatus$ End If tools.toolPointerOFF.Visible = False tools.toolPointerON.Visible = True toolStatus$ = "pointer" End If Select Case SelectObject$ Case "pointer": Call DotAllHide 'Case "textedit": Case "text": Call Shape_FourDotMove(Text1(TextNo)) Case "line": Call Line_TwoDotMove(Line1(CurrentNo)) Case "rectangle": Call Shape_FourDotMove(Rectangle1(CurrentNo)) Case "roundrectangle": Call Shape_FourDotMove(Roundrectangle1(CurrentNo)) Case "circle": Call Shape_FourDotMove(Circle1(CurrentNo)) Case "diamond": Call Shape_FourDotMove(Diamond(CurrentNo)) End Select End If End Sub Sub Line_TwoDotMove (L As Line) Dot1.Move (L.X1 - Dot1.Width / 2), (L.Y1 - Dot1.Height / 2) Dot2.Move (L.X2 - Dot2.Width / 2), (L.Y2 - Dot2.Height / 2) Dot1.ZOrder 0 Dot2.ZOrder 0 Dot1.Visible = True: Dot2.Visible = True End Sub Sub menuEditBF_Click () Call DotAllHide Select Case SelectObject$ Case "text" If DataText(1) = 1 Then Call DuplicateText(tempText, Text1(TextNo)) Call DuplicateText(Text1(TextNo), Text1(1)) Call DuplicateText(Text1(1), tempText) tempText.Visible = False Else Load Text1(1) DataText(1) = 1 Call DuplicateText(Text1(1), Text1(TextNo)) Unload Text1(TextNo) DataText(TextNo) = 0 Do Until DataText(MaxText) = 1 MaxText = MaxText - 1 Loop End If Text1(1).ZOrder 0 Call Shape_FourDotMove(Text1(1)) TextNo = 1 Case "line" If DataLine(1) = 1 Then Call DuplicateLine(tempLine, Line1(CurrentNo)) Call DuplicateLine(Line1(CurrentNo), Line1(1)) Call DuplicateLine(Line1(1), tempLine) tempLine.Visible = False Else Load Line1(1) DataLine(1) = 1 Call DuplicateLine(Line1(1), Line1(CurrentNo)) Unload Line1(CurrentNo) DataLine(CurrentNo) = 0 Do Until DataLine(MaxLine) = 1 MaxLine = MaxLine - 1 Loop End If Line1(1).ZOrder 0 Call Line_TwoDotMove(Line1(1)) CurrentNo = 1 Case "rectangle" If DataRectangle(1) = 1 Then Call DuplicateShape(tempShape, Rectangle1(CurrentNo)) Call DuplicateShape(Rectangle1(CurrentNo), Rectangle1(1)) Call DuplicateShape(Rectangle1(1), tempShape) tempShape.Visible = False Else Load Rectangle1(1) DataRectangle(1) = 1 Call DuplicateShape(Rectangle1(1), Rectangle1(CurrentNo)) Unload Rectangle1(CurrentNo) DataRectangle(CurrentNo) = 0 Do Until DataRectangle(MaxRectangle) = 1 MaxRectangle = MaxRectangle - 1 Loop End If Rectangle1(1).ZOrder 0 Call Shape_FourDotMove(Rectangle1(1)) CurrentNo = 1 Case "roundrectangle" If DataRoundrectangle(1) = 1 Then Call DuplicateShape(tempShape, Roundrectangle1(CurrentNo)) Call DuplicateShape(Roundrectangle1(CurrentNo), Roundrectangle1(1)) Call DuplicateShape(Roundrectangle1(1), tempShape) tempShape.Visible = False Else Load Roundrectangle1(1) DataRoundrectangle(1) = 1 Call DuplicateShape(Roundrectangle1(1), Roundrectangle1(CurrentNo)) Unload Roundrectangle1(CurrentNo) DataRoundrectangle(CurrentNo) = 0 Do Until DataRoundrectangle(MaxRoundrectangle) = 1 MaxRoundrectangle = MaxRoundrectangle - 1 Loop End If Roundrectangle1(1).ZOrder 0 Call Shape_FourDotMove(Roundrectangle1(1)) CurrentNo = 1 Case "circle" If DataCircle(1) = 1 Then Call DuplicateShape(tempShape, Circle1(CurrentNo)) Call DuplicateShape(Circle1(CurrentNo), Circle1(1)) Call DuplicateShape(Circle1(1), tempShape) tempShape.Visible = False Else Load Circle1(1) DataCircle(1) = 1 Call DuplicateShape(Circle1(1), Circle1(CurrentNo)) Unload Circle1(CurrentNo) DataCircle(CurrentNo) = 0 Do Until DataCircle(MaxCircle) = 1 MaxCircle = MaxCircle - 1 Loop End If Circle1(1).ZOrder 0 Call Shape_FourDotMove(Circle1(1)) CurrentNo = 1 Case "diamond" If DataDiamond(1) = 1 Then Call DuplicateShape(tempShape, Diamond(CurrentNo)) Call DuplicateShape(Diamond(CurrentNo), Diamond(1)) Call DuplicateShape(Diamond(1), tempShape) tempShape.Visible = False Call DiamondDraw(Diamond(1), 1) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) Else Load Diamond(1) Load Diamond1(4): Load Diamond1(5): Load Diamond1(6): Load Diamond1(7) DataDiamond(1) = 1 Call DuplicateShape(Diamond(1), Diamond(CurrentNo)) Call DiamondDraw(Diamond(1), 1) Unload Diamond(CurrentNo) Unload Diamond1(CurrentNo * 4) Unload Diamond1(CurrentNo * 4 + 1) Unload Diamond1(CurrentNo * 4 + 2) Unload Diamond1(CurrentNo * 4 + 3) DataDiamond(CurrentNo) = 0 Do Until DataDiamond(MaxDiamond) = 1 MaxDiamond = MaxDiamond - 1 Loop End If Diamond1(4).ZOrder 0 Diamond1(5).ZOrder 0 Diamond1(6).ZOrder 0 Diamond1(7).ZOrder 0 Call Shape_FourDotMove(Diamond(1)) CurrentNo = 1 End Select End Sub Sub menuEditCopy_Click () Dim i As Integer Call DotAllHide Select Case SelectObject$ Case "text": For i = 1 To 1000 If DataText(i) = 0 Then Load Text1(i) If MaxText < i Then MaxText = i DataText(i) = 1 Text1(TextNo).BackColor = RGB(&HFF, &HFF, &HFF) Call DuplicateText(Text1(i), Text1(TextNo)) Text1(i).Left = Text1(i).Left + 120 Text1(i).Top = Text1(i).Top + 120 Call TextAttrib(Text1(i)) TextNo = i Call menuEditBF_Click Exit For End If Next i Case "line": For i = 1 To 1000 If DataLine(i) = 0 Then Load Line1(i) If MaxLine < i Then MaxLine = i DataLine(i) = 1 Call DuplicateLine(Line1(i), Line1(CurrentNo)) Line1(i).X1 = Line1(i).X1 + 120 Line1(i).Y1 = Line1(i).Y1 + 120 Line1(i).X2 = Line1(i).X2 + 120 Line1(i).Y2 = Line1(i).Y2 + 120 CurrentNo = i Call menuEditBF_Click Exit For End If Next i Case "rectangle": For i = 1 To 1000 If DataRectangle(i) = 0 Then Load Rectangle1(i) If MaxRectangle < i Then MaxRectangle = i DataRectangle(i) = 1 Call DuplicateShape(Rectangle1(i), Rectangle1(CurrentNo)) Rectangle1(i).Top = Rectangle1(i).Top + 120 Rectangle1(i).Left = Rectangle1(i).Left + 120 CurrentNo = i Call menuEditBF_Click Exit For End If Next i Case "roundrectangle": For i = 1 To 1000 If DataRoundrectangle(i) = 0 Then Load Roundrectangle1(i) If MaxRoundrectangle < i Then MaxRoundrectangle = i DataRoundrectangle(i) = 1 Call DuplicateShape(Roundrectangle1(i), Roundrectangle1(CurrentNo)) Roundrectangle1(i).Top = Roundrectangle1(i).Top + 120 Roundrectangle1(i).Left = Roundrectangle1(i).Left + 120 CurrentNo = i Call menuEditBF_Click Exit For End If Next i Case "circle": For i = 1 To 1000 If DataCircle(i) = 0 Then Load Circle1(i) If MaxCircle < i Then MaxCircle = i DataCircle(i) = 1 Call DuplicateShape(Circle1(i), Circle1(CurrentNo)) Circle1(i).Top = Circle1(i).Top + 120 Circle1(i).Left = Circle1(i).Left + 120 CurrentNo = i Call menuEditBF_Click Exit For End If Next i Case "diamond": For i = 1 To 1000 If DataDiamond(i) = 0 Then Load Diamond(i) Load Diamond1(i * 4) Load Diamond1(i * 4 + 1) Load Diamond1(i * 4 + 2) Load Diamond1(i * 4 + 3) If MaxDiamond < i Then MaxDiamond = i DataDiamond(i) = 1 Call DuplicateShape(Diamond(i), Diamond(CurrentNo)) Diamond(CurrentNo).Visible = False Diamond(i).Top = Diamond(i).Top + 120 Diamond(i).Left = Diamond(i).Left + 120 Call DiamondDraw(Diamond(i), i) CurrentNo = i Call menuEditBF_Click Exit For End If Next i End Select End Sub Sub menuEditDelete_Click () Select Case SelectObject$ Case "text": Unload Text1(TextNo) DataText(TextNo) = 0 Do Until DataText(MaxText) = 1 MaxText = MaxText - 1 If MaxText = 0 Then Exit Do Loop Case "line": Unload Line1(CurrentNo) DataLine(CurrentNo) = 0 Do Until DataLine(MaxLine) = 1 MaxLine = MaxLine - 1 If MaxLine = 0 Then Exit Do Loop Case "rectangle": Unload Rectangle1(CurrentNo) DataRectangle(CurrentNo) = 0 Do Until DataRectangle(MaxRectangle) = 1 MaxRectangle = MaxRectangle - 1 If MaxRectangle = 0 Then Exit Do Loop Case "roundrectangle": Unload Roundrectangle1(CurrentNo) DataRoundrectangle(CurrentNo) = 0 Do Until DataRoundrectangle(MaxRoundrectangle) = 1 MaxRoundrectangle = MaxRoundrectangle - 1 If MaxRoundrectangle = 0 Then Exit Do Loop Case "circle": Unload Circle1(CurrentNo) DataCircle(CurrentNo) = 0 Do Until DataCircle(MaxCircle) = 1 MaxCircle = MaxCircle - 1 If MaxCircle = 0 Then Exit Do Loop Case "diamond": Unload Diamond(CurrentNo) Unload Diamond1(CurrentNo * 4) Unload Diamond1(CurrentNo * 4 + 1) Unload Diamond1(CurrentNo * 4 + 2) Unload Diamond1(CurrentNo * 4 + 3) DataDiamond(CurrentNo) = 0 Do Until DataDiamond(MaxDiamond) = 1 MaxDiamond = MaxDiamond - 1 If MaxDiamond = 0 Then Exit Do Loop End Select Call DotAllHide SelectObject$ = "pointer" End Sub Sub menuEditSB_Click () Call DotAllHide Select Case SelectObject$ Case "text" Call DuplicateText(tempText, Text1(TextNo)) Call DuplicateText(Text1(TextNo), Text1(MaxText)) Call DuplicateText(Text1(MaxText), tempText) tempText.Visible = False Text1(MaxText).ZOrder 1 Call Shape_FourDotMove(Text1(MaxText)) TextNo = MaxText Case "line" Call DuplicateLine(tempLine, Line1(CurrentNo)) Call DuplicateLine(Line1(CurrentNo), Line1(MaxLine)) Call DuplicateLine(Line1(MaxLine), tempLine) tempLine.Visible = False Line1(MaxLine).ZOrder 1 Call Line_TwoDotMove(Line1(MaxLine)) CurrentNo = MaxLine Case "rectangle" Call DuplicateShape(tempShape, Rectangle1(CurrentNo)) Call DuplicateShape(Rectangle1(CurrentNo), Rectangle1(MaxRectangle)) Call DuplicateShape(Rectangle1(MaxRectangle), tempShape) tempShape.Visible = False Rectangle1(MaxRectangle).ZOrder 1 Call Shape_FourDotMove(Rectangle1(MaxRectangle)) CurrentNo = MaxRectangle Case "roundrectangle" Call DuplicateShape(tempShape, Roundrectangle1(CurrentNo)) Call DuplicateShape(Roundrectangle1(CurrentNo), Roundrectangle1(MaxRoundrectangle)) Call DuplicateShape(Roundrectangle1(MaxRoundrectangle), tempShape) tempShape.Visible = False Roundrectangle1(MaxRoundrectangle).ZOrder 1 Call Shape_FourDotMove(Roundrectangle1(MaxRoundrectangle)) CurrentNo = MaxRoundrectangle Case "circle" Call DuplicateShape(tempShape, Circle1(CurrentNo)) Call DuplicateShape(Circle1(CurrentNo), Circle1(MaxCircle)) Call DuplicateShape(Circle1(MaxCircle), tempShape) tempShape.Visible = False Circle1(MaxCircle).ZOrder 1 Call Shape_FourDotMove(Circle1(MaxCircle)) CurrentNo = MaxCircle Case "diamond" Call DuplicateShape(tempShape, Diamond(CurrentNo)) Call DuplicateShape(Diamond(CurrentNo), Diamond(MaxDiamond)) Call DuplicateShape(Diamond(MaxDiamond), tempShape) tempShape.Visible = False Call DiamondDraw(Diamond(MaxDiamond), MaxDiamond) Call DiamondDraw(Diamond(CurrentNo), CurrentNo) Diamond1(MaxDiamond * 4).ZOrder 1 Diamond1(MaxDiamond * 4 + 1).ZOrder 1 Diamond1(MaxDiamond * 4 + 2).ZOrder 1 Diamond1(MaxDiamond * 4 + 3).ZOrder 1 Call Shape_FourDotMove(Diamond(MaxDiamond)) CurrentNo = MaxDiamond End Select End Sub Sub menuFileNew_Click () Dim i As Integer For i = 1 To 1000 If DataText(i) = 1 Then Unload Text1(i) If DataLine(i) = 1 Then Unload Line1(i) If DataRectangle(i) = 1 Then Unload Rectangle1(i) If DataRoundrectangle(i) = 1 Then Unload Roundrectangle1(i) If DataCircle(i) = 1 Then Unload Circle1(i) If DataDiamond(i) = 1 Then Unload Diamond(i) Unload Diamond1(i * 4) Unload Diamond1(i * 4 + 1) Unload Diamond1(i * 4 + 2) Unload Diamond1(i * 4 + 3) End If Next i For i = 1 To MaxFont - 1 Unload menuTextFontName(i) Next i Call Form_Load End Sub Sub menuFileOpen_Click () file.Show file.Caption = "Open" SaveOrLoad = "Load" main.Enabled = False tools.Enabled = False End Sub Sub menuFilePrint_Click () On Error GoTo ERR_PRN Call DotAllHide Call Form_Deactivate main.PrintForm Exit Sub ERR_PRN: MsgBox "Printer setting error, please check printer connection", 48, "Printer Error" Resume Next End Sub Sub menuFileQuit_Click () End '--- Quit this program --- End Sub Sub menuFileSave_Click () Call FileSave End Sub Sub menuFileSaveas_Click () file.Show file.Caption = "Save As" SaveOrLoad = "Save" main.Enabled = False tools.Enabled = False End Sub Sub menuHelpAbout_Click () about.Show main.Enabled = False tools.Enabled = False End Sub Sub menuTextBold_Click () menuTextBold.Checked = Not menuTextBold.Checked If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontBold = menuTextBold.Checked End Sub Sub menuTextFontName_Click (Index As Integer) Dim i As Integer For i = 1 To MaxFont menuTextFontName(i - 1).Checked = False Next i If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontName = menuTextFontName(Index).Caption menuTextFontName(Index).Checked = True If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextItalic_Click () menuTextItalic.Checked = Not menuTextItalic.Checked If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontItalic = menuTextItalic.Checked End Sub Sub menuTextSize10_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 10 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize12_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 12 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize14_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 14 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize18_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 18 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize24_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 24 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize36_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 36 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize48_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 48 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize60_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 60 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize72_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 72 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextSize9_Click () If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontSize = 9 If SelectObject = "text" Then Call Shape_FourDotMove(Text1(TextNo)) End Sub Sub menuTextStrikethru_Click () menuTextStrikethru.Checked = Not menuTextStrikethru.Checked If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontStrikethru = menuTextStrikethru.Checked End Sub Sub menuTextUnderline_Click () menuTextUnderline.Checked = Not menuTextUnderline.Checked If SelectObject$ = "pointer" Then TextNo = 0 Text1(TextNo).FontUnderline = menuTextUnderline.Checked End Sub Sub menuToolSound_Click () If menuToolSound.Checked Then menuToolSound.Checked = False Else menuToolSound.Checked = True End If End Sub Sub menuToolTools_Click () tools.Show End Sub Sub Shape_FourDotMove (S As Control) DotLU.Move (S.Left - DotLU.Width / 2), (S.Top - DotLU.Height / 2) DotLD.Move (S.Left - DotLD.Width / 2), (S.Top + S.Height - DotLD.Height / 2) DotRU.Move (S.Left + S.Width - DotRU.Width / 2), (S.Top - DotRU.Height / 2) DotRD.Move (S.Left + S.Width - DotRD.Width / 2), (S.Top + S.Height - DotRD.Height / 2) DotLU.ZOrder 0 DotLD.ZOrder 0 DotRU.ZOrder 0 DotRD.ZOrder 0 DotLU.Visible = True: DotLD.Visible = True DotRU.Visible = True: DotRD.Visible = True End Sub Sub ShapeInitNew (S As Control, X As Single, Y As Single) S.Left = X: S.Top = Y S.Width = 100: S.Height = 100 S.Visible = True End Sub Sub ShapeLDZoom (S As Control, X As Single, Y As Single, ByVal X_LD As Single, ByVal Y_LD As Single, ByVal X_RU As Single, ByVal Y_RU As Single) S.Visible = False If (X_RU - (X_LD + X - DragX) > 100) Then S.Left = X_LD + X - DragX S.Width = X_RU - S.Left End If If (Y_LD + Y - DragY - Y_RU > 100) Then S.Top = Y_RU S.Height = Y_LD + Y - DragY - Y_RU End If S.Visible = True End Sub Sub ShapeLUZoom (S As Control, X As Single, Y As Single, ByVal X_LU As Single, ByVal Y_LU As Single, ByVal X_RD As Single, ByVal Y_RD As Single) S.Visible = False If (X_RD - (X_LU + X - DragX) > 100) Then S.Left = X_LU + X - DragX S.Width = X_RD - S.Left End If If (Y_RD - (Y_LU + Y - DragY) > 100) Then S.Top = Y_LU + Y - DragY S.Height = Y_RD - S.Top End If S.Visible = True End Sub Sub ShapeRDZoom (S As Control, X As Single, Y As Single, ByVal X_LU As Single, ByVal Y_LU As Single, ByVal X_RD As Single, ByVal Y_RD As Single) S.Visible = False If (X_RD + X - DragX - X_LU > 100) Then S.Left = X_LU S.Width = X_RD + X - DragX - X_LU End If If (Y_RD + Y - DragY - Y_LU > 100) Then S.Top = Y_LU S.Height = Y_RD + Y - DragY - Y_LU End If S.Visible = True End Sub Sub ShapeRUZoom (S As Control, X As Single, Y As Single, ByVal X_LD As Single, ByVal Y_LD As Single, ByVal X_RU As Single, ByVal Y_RU As Single) S.Visible = False If (X_RU + X - DragX - X_LD > 100) Then S.Left = X_LD S.Width = X_RU + X - DragX - X_LD End If If (Y_LD - (Y_RU + Y - DragY) > 100) Then S.Top = Y_RU + Y - DragY S.Height = Y_LD - S.Top End If S.Visible = True End Sub Sub Text1_KeyPress (Index As Integer, KeyAscii As Integer) If KeyAscii = &H1B Then 'KEY_ESCAPE SelectObject$ = "text" Text1(TextNo).SelStart = 0 Text1(Index).Enabled = False menuEdit.Enabled = True Call Shape_FourDotMove(Text1(Index)) End If End Sub Sub TextAttrib (T As TextBox) Dim i As Integer T.BackColor = RGB(&HC0, &HC0, &HC0) menuTextBold.Checked = T.FontBold menuTextItalic.Checked = T.FontItalic menuTextStrikethru.Checked = T.FontStrikethru menuTextUnderline.Checked = T.FontUnderline 'Set menuTextFontName to current TextFont For i = 1 To MaxFont If Text1(TextNo).FontName = menuTextFontName(i - 1).Caption Then menuTextFontName(i - 1).Checked = True Else menuTextFontName(i - 1).Checked = False End If Next i End Sub